!> author: 左志华
!> date: 2022-05-05
!> ERROR STOP
!> Fortran程序设计目的性较强，主要用于科学计算，报错给出msg、code、procedure有助于代码的快速定位和错误分析。
module error_stop_m

    implicit none
    private

    public :: error_stop

    interface error_stop
        procedure :: error_stop_msg, error_stop_code
    end interface error_stop

contains

    !> Error message
    !> 出错信息
    impure subroutine error_stop_msg(msg, procedure, no_backtrace)
        character(*), intent(in) :: msg                     !! error message
                                                            !! 出错信息
        character(*), intent(in) :: procedure               !! procedure name
                                                            !! 出错程序名
        logical, intent(in), optional :: no_backtrace       !! no backtrace flag, default is .false.
                                                            !! 是否不输出 backtrace 信息，默认为 .false.
        logical :: no_backtrace_
        character(:), allocatable :: error_procedure_msg

        if (present(no_backtrace)) then
            no_backtrace_ = no_backtrace
        else
            no_backtrace_ = .false.
        end if

        write (*, '(a15,a)') 'ERROR MESSAGE: ', msg
        error_procedure_msg = 'PROCEDURE: '//procedure

        if (no_backtrace_) then
            stop error_procedure_msg
        else
            error stop error_procedure_msg
        end if

    end subroutine error_stop_msg

    !> Error code
    !> 出错代码
    impure subroutine error_stop_code(code, procedure, no_backtrace)
        integer, intent(in) :: code                         !! error code
                                                            !! 出错代码
        character(*), intent(in) :: procedure               !! procedure name
                                                            !! 出错程序名
        logical, intent(in), optional :: no_backtrace       !! no backtrace flag, default is .false.
                                                            !! 是否不输出 backtrace 信息，默认为 .false.
        logical :: no_backtrace_
        character(:), allocatable :: error_procedure_msg

        if (present(no_backtrace)) then
            no_backtrace_ = no_backtrace
        else
            no_backtrace_ = .false.
        end if

        write (*, '(a12,i0)') 'ERROR CODE: ', code
        error_procedure_msg = 'PROCEDURE: '//procedure

        if (no_backtrace_) then
            stop error_procedure_msg
        else
            error stop error_procedure_msg
        end if

    end subroutine error_stop_code

end module error_stop_m
